home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Testers / Harmonizer Tester < prev    next >
Lisp/Scheme  |  1998-10-26  |  2KB  |  70 lines
  1. ; try changing the theme, all stuff comes from that...
  2.  
  3. (setq theme '(a b c d e f e d c b c d c b a h g h f e d h g h e d c h g h d e f b e d))
  4.  
  5. (setq mel (gen-expansion 1 '(a d c -c b)
  6.                          (symbol-retrograde 
  7.                           (gen-loop '((8 1 1 4) (2 1 1 2))
  8.                                     theme))))
  9.  
  10. (init-soup 'soup1 mel)
  11. (setq variations (symbol-trim (* (length theme) 6) (gen-catalyze 'soup1 0.234 30)))
  12.  
  13. (setq left-hand (append theme (symbol-transpose 8 (symbol-inversion 'a theme)) variations))
  14. (setq right-hand (symbol-transpose 11 (symbol-shift 32 (append theme (symbol-transpose 8 (symbol-inversion 'a theme)) variations))))
  15. (setq 3rd-hand (symbol-transpose -5 (symbol-shift 64 (append theme (symbol-transpose 8 (symbol-inversion 'a theme)) variations))))
  16.  
  17. (setq new-mater (filter-harmonize3
  18.                  left-hand right-hand 3rd-hand 12
  19.                  (activate-tonality (harmonic-minor c 4))
  20.                  '((32 3)) 
  21.                  '((1 2 5 6 8 9 10 11)) ; ok too '((1 2 5 6 9 10 11)), or '((1 2 5 6 10 11)) 
  22.                  '(0 5 7)))
  23.  
  24. (setq hmat1 (filter-deactivate 8 40 (find-change (car new-mater))))
  25. (setq hmat2 (filter-deactivate 8 40 (find-change (cadr new-mater))))
  26. (setq hmat3 (filter-deactivate 8 40 (find-change (caddr new-mater))))
  27.  
  28. (def-instrument-symbol
  29.    lh (symbol-melodize-skip hmat1)
  30.    rh (symbol-shift 1 (symbol-melodize-skip hmat2))
  31.    mh (symbol-shift 1 (symbol-melodize-skip hmat3))
  32. )
  33.  
  34. (def-instrument-length
  35.    lh (get-timing '1/8 hmat1)
  36.    rh (get-timing '1/8 hmat2)
  37.    mh (get-timing '1/8 hmat3)
  38. )
  39.  
  40. (def-instrument-zone
  41.    lh '(16/1 16/1 8/1)
  42.    rh '(16/1 16/1 8/1)
  43.    mh '(16/1 16/1 8/1)
  44. )
  45.  
  46. (def-instrument-tonality
  47.    lh (activate-tonality (harmonic-minor c 4))
  48.    rh (activate-tonality (harmonic-minor c 4))
  49.    mh (activate-tonality (harmonic-minor c 4))
  50. )
  51.  
  52. (def-instrument-velocity
  53.    lh (symbol-to-velocity 50 127 3 (symbol-repeat 4 theme))
  54.    rh (symbol-to-velocity 50 127 3 (reverse (symbol-repeat 4 theme)))
  55.    mh (symbol-to-velocity 50 127 3 (reverse (symbol-repeat 4 theme)))
  56. )
  57.  
  58. (def-instrument-channel
  59.    lh 1
  60.    rh 2
  61.    mh 3
  62. )
  63.  
  64. (compile-instrument-p "ccl;output:" "fugue"
  65.   lh
  66.   rh
  67.   mh
  68. )
  69.  
  70.